home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / NLCOMP.PAS < prev    next >
Pascal/Delphi Source File  |  1996-06-25  |  66KB  |  1,545 lines
  1. UNIT NLComp;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Nodeliste compiler                            Last changed: 25.06.96  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-96 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                And special guest star: Birger Kristensen                 ║}
  8. {║                                                                          ║}
  9. {║ This source may not be given to anybody, without the written permission  ║}
  10. {║ from The Portal Team.                                                    ║}
  11. {╚══════════════════════════════════════════════════════════════════════════╝}
  12. {$I POPDEFS.INC}
  13.  
  14. INTERFACE
  15.  
  16. USES Use32;
  17.  
  18. PROCEDURE CompileNodeList(Forced: Boolean);
  19.  
  20. IMPLEMENTATION
  21.  
  22. USES OpCrt, OpDos, OpString, OpWindow, OpRoot, OpLArray,
  23.      Util, Globals, Dos, NodeList, FileUtil, OproUtil, StrUtil, Com,
  24.      Keyboard, InterCom, LogFile, NetFile, Crc, MTask, ArcView, PoPTypes,
  25.      MailUtil, Display, FuncSrvr, BTree, AreaMisc
  26.      { indsat BK'94 },OPUS_173{ indsat BK'94 };
  27.  
  28. TYPE      { indsat BK'94 }
  29.   CtlBlock = RECORD
  30.                ControlBlockSize : WORD;    { Blocksize of Index Blocks  }
  31.                ControlRoot,                { Block number of Root       }
  32.                ControlHiBlock,             { Block number of last block }
  33.                ControlLowLeaf   : LONGINT; { Block number of first leaf }
  34.                ControlHighLeaf  : LONGINT; { Block number of last leaf  }
  35.                ControlFree      : LONGINT; { Head of freelist           }
  36.                ControlLevels    : WORD;    { Number of index levels     }
  37.                ControlParity    : WORD;    { XOR of above fields        }
  38.              END;
  39.  
  40.   INodeBlk = RECORD
  41.                IndexFirst    : LONGINT; { Pointer to next lower level }
  42.                IndexBLink    : LONGINT; { Pointer to previous link    }
  43.                IndexFLink    : LONGINT; { Pointer to next link        }
  44.                IndexCount    : INTEGER; { Count of Items in block     }
  45.                IndexStr      : WORD;    { Offset in block of 1st str  }
  46.                {If IndxFirst is NOT -1, this is INode:}
  47.                IndexRef      : ARRAY[0..49] OF
  48.                    RECORD
  49.                      IndexOfs  : WORD;    { Offset of string into block }
  50.                      IndexLen  : WORD;    { Length of string            }
  51.                      IndexData : LONGINT; { Record number of string     }
  52.                      IndexPtr  : LONGINT; { Block number of lower index }
  53.                    END;
  54.              END;
  55.  
  56.   LNodeBlk = RECORD
  57.                IndexFirst   : LONGINT;      { Pointer to next lower level }
  58.                IndexBLink   : LONGINT;      { Pointer to previous link    }
  59.                IndexFLink   : LONGINT;      { Pointer to next link        }
  60.                IndexCount   : INTEGER;      { Count of Items in block     }
  61.                IndexStr     : WORD;         { Offset in block of 1st str  }
  62.                LeafRef      : ARRAY [0..49] OF
  63.                   RECORD
  64.                     KeyOfs : WORD;      { Offset of string into block }
  65.                     KeyLen : WORD;      { Length of string            }
  66.                     KeyVal : LONGINT;   { Pointer to data block       }
  67.                   END;
  68.              END;
  69.  
  70.   bigleaf  = RECORD
  71.                IndexFirst   : LONGINT;      { Pointer to next lower level }
  72.                IndexBLink   : LONGINT;      { Pointer to previous link    }
  73.                IndexFLink   : LONGINT;      { Pointer to next link        }
  74.                IndexCount   : INTEGER;      { Count of Items in block     }
  75.                IndexStr     : WORD;         { Offset in block of 1st str  }
  76.                LeafRef      : ARRAY [0..50] OF
  77.                   RECORD
  78.                     KeyOfs : WORD;    { Offset of string into block }
  79.                     KeyLen : WORD;    { Length of string            }
  80.                     KeyVal : LONGINT; { Pointer to data block       }
  81.                   END;
  82.              END;
  83.  
  84.   bigindex  = RECORD
  85.                 IndexFirst    : LONGINT; { Pointer to next lower level }
  86.                 IndexBLink    : LONGINT; { Pointer to previous link    }
  87.                 IndexFLink    : LONGINT; { Pointer to next link        }
  88.                 IndexCount    : INTEGER; { Count of Items in block     }
  89.                 IndexStr      : WORD;    { Offset in block of 1st str  }
  90.                 {If IndxFirst is NOT -1, this is INode:}
  91.                 IndexRef      : ARRAY [0..50] OF
  92.                     RECORD
  93.                       IndexOfs     : WORD; { Offset of string into block }
  94.                       IndexLen     : WORD; { Length of string            }
  95.                       IndexData    : LONGINT; { Record number of string     }
  96.                       IndexPtr     : LONGINT; { Block number of lower index }
  97.                     END;
  98.               END; { indsat bk'94 }
  99.  
  100.  
  101. PROCEDURE CompileNodeList(Forced: Boolean);
  102. VAR
  103.   FidoUser,v7 : OpArray;
  104.   Temp     : WindowPtr;
  105.   FoundOne : Boolean;
  106.   FidoUserNum,
  107.   normcost : WORD;
  108.   Test,num,numcost:INTEGER;
  109.   sr:SearchRec;
  110.   HostPhone:S40;
  111.   s,oldnlname:STRING;
  112.   RE:NodeExtra;
  113.   NodeListSegRec  : TNodeListSeg;
  114.   NodeListSegFile : TNetFile;
  115.  
  116.   FUNCTION FindOldNlName(VAR OldNlName: String; VAR Num: Integer): Boolean;
  117.   VAR
  118.     Test, MaxNum : Integer;
  119.     Sr           : SearchRec;
  120.   BEGIN
  121.     MaxNum:=-1;
  122.     OldNLName:='';
  123.     FindFirst(Cfg.NodeList+NodeListSegRec.NodeListName+'.*', AnyFile, sr);
  124.     WHILE DOSError=0 DO
  125.     BEGIN
  126.       Val(Copy(Sr.Name, Pos('.', Sr.Name)+1,3), Num, Test);
  127.       IF (Test=0) AND (Num>MaxNum) THEN
  128.       BEGIN
  129.         MaxNum:=Num;
  130.         OldNLName:=Cfg.NodeList+Sr.Name;
  131.       END;
  132.       FindNext(sr);
  133.     END;
  134.     FindClose(sr);
  135.     Num:=MaxNum;
  136.     FindOldNlName:=(OldNlName<>'');
  137.   END;
  138.  
  139.   FUNCTION ProcessNodeDiff: Boolean;
  140.   LABEL
  141.     LookForMore;
  142.   VAR
  143.     Found, GoodCRC       : Boolean;
  144.     Sr                   : SearchRec;
  145.     BufSize              : LONGINT;
  146.     numofdays, x, newnum : Integer;
  147.     BadName, PackedDiff,
  148.     DiffName, OldDir, s  : String;
  149.     Ind, Ud, NodeDiff    : TBufTextFile;
  150.     i, y,
  151.     m, d, dofw           : Word;
  152.     Ch                   : Char;
  153.  
  154.     FUNCTION GoodNLCRC:BOOLEAN;
  155.     VAR
  156.       f:BufIdStream;
  157.       s:STRING;
  158.       BufSize:LONGINT;
  159.       CrcOk,Crc16:WORD;
  160.       i:INTEGER;
  161.       ch:CHAR;
  162.     BEGIN
  163.       BufSize:=Max64k(MaxAvail-1024);
  164.       f.Init(Cfg.Nodelist+'PORTAL.$$$', SOpenRead, BufSize);
  165.       s:='';
  166.       REPEAT
  167.         f.Read(ch,1);
  168.         IF (ch<>#10) AND (ch<>#13) THEN s:=s+ch;
  169.       UNTIL ch=#10;
  170.       i:=Length(s);
  171.       WHILE (s[i]>='0') AND (s[i]<='9') DO
  172.         Dec(i);
  173.       Val(Copy(s,i+1,5), CrcOk, i);
  174.       Crc16:=0;
  175.       WHILE f.IdStatus=0 DO
  176.       BEGIN
  177.         f.Read(ch,1);
  178.         IF f.IdStatus=0 THEN Crc16:=UpdCrc16(Byte(ch),Crc16);
  179.       END;
  180.       f.Done;
  181.       Crc16:=UpdCrc16(0,Crc16);
  182.       Crc16:=UpdCrc16(0,Crc16);
  183.       GoodNLCRC:=(CrcOk=Crc16);
  184.     END;
  185.  
  186.     PROCEDURE AddToFilesBBS(NewName, OldName: S12);
  187.     VAR
  188.       FilesBBS,
  189.       NewFilesBBS : PBufTextFile;
  190.       Line, s     : String;
  191.     BEGIN
  192.       WriteLn('Adding new nodelist to FILES.BBS');
  193.       Line:=CPad(NewName, 13)+NodeListSegRec.NewNLDesc;
  194.       IF Cfg.AreaMan.InsDLCnt THEN AddDlC(Line);
  195.       New(FilesBBS, InitCreate(AddBackSlash(NodeListSegRec.NewNLPath)+'FILES.BBS', SOpen+ShareDenyNone, 2048));
  196.       IF FilesBBS=NIL THEN
  197.       BEGIN
  198.         WriteLn('Can''t update '+AddBackSlash(NodeListSegRec.NewNLPath)+'FILES.BBS with description: '+Line);
  199.       END ELSE
  200.       BEGIN
  201.         New(NewFilesBBS, Init(AddBackSlash(NodeListSegRec.NewNLPath)+'NLC-TMP.$$$', SCreate, 2048));
  202.         IF NewFilesBBS=NIL THEN
  203.         BEGIN
  204.           FilesBBS^.WriteLn(Line);
  205.           Dispose(FilesBBS, Done);
  206.         END ELSE
  207.         BEGIN
  208.           FilesBBS^.SetPos(0, PosAbs);
  209.           Found:=False;
  210.           WHILE NOT FilesBBS^.EoF AND (NewFilesBBS^.GetStatus=0) DO
  211.           BEGIN
  212.             FilesBBS^.ReadLn(s);
  213.             IF (Pos(' ',s)>0) AND (StUpCase(Copy(s,1,Pos(' ',s)-1))=OldName) THEN
  214.             BEGIN
  215.               Found:=True;
  216. {             IF Cfg.AreaMan.InsDLCnt THEN IncDLC(Line, GetDLC(s));}
  217.               NewFilesBBS^.WriteLn(Line);
  218.             END ELSE
  219.               NewFilesBBS^.WriteLn(s);
  220.           END;
  221.           IF Not Found THEN NewFilesBBS^.WriteLn(Line);
  222.           IF NewFilesBBS^.GetStatus<>0 THEN
  223.           BEGIN
  224.             AddLog('!', 'Can''t update FILES.BBS with description: '+Line);
  225.             Dispose(FilesBBS, Done); Dispose(NewFilesBBS, Done);
  226.             DeleteFile(AddBackSlash(NodeListSegRec.NewNLPath)+'NLC-TMP.$$$');
  227.           END ELSE
  228.           BEGIN
  229.             IF Found THEN
  230.             BEGIN
  231.               IF DeleteFile(AddBackSlash(NodeListSegRec.NewNLPath)+OldName) THEN
  232.                 AddLog(':', 'Erasing '+OldName+' replaced by '+NewName);
  233.             END;
  234.             Dispose(FilesBBS, Done); Dispose(NewFilesBBS, Done);
  235.             DeleteFile(AddBackSlash(NodeListSegRec.NewNLPath)+'FILES.BBS');
  236.             RenameFile(AddBackSlash(NodeListSegRec.NewNLPath)+'NLC-TMP.$$$',
  237.                        AddBackSlash(NodeListSegRec.NewNLPath)+'FILES.BBS');
  238.           END;
  239.         END;
  240.       END;
  241.     END;
  242.  
  243.   BEGIN
  244.     Found:=False;
  245.     WriteLn('Looking for '+NodeListSegRec.DiffFileName+'''s');
  246. LookForMore:
  247.     newnum:=num+7;
  248.     GetDate(y,m,d,dofw);
  249.     Dec(y);
  250.     IF (y MOD 4=0) AND (y MOD 100<>0) THEN numofdays:=366 ELSE numofdays:=365;
  251.     IF newnum>numofdays THEN newnum:=newnum-numofdays;
  252.     s:=Cfg.Nodelist+NodeListSegRec.DiffFileName+'.'+LongIntForm('@@@',newnum);
  253.     diffname:=s;
  254.     s[Length(s)-2]:='?';
  255.     FindFirst(s,AnyFile,sr);
  256.     WHILE (DosError=0) And Not (sr.Name[Length(Sr.name)-2] IN ['A'..'Z']) DO
  257.       FindNext(Sr);
  258.     IF DOSError=0 THEN
  259.     BEGIN
  260.       Found:=True;
  261.       GetDir(0,olddir);
  262.       ChangeDir(Cfg.Nodelist);
  263.       WriteLn('Unpacking '+sr.name);
  264.       ArcCommand(ArcType(sr.Name),2,sr.name,'*.0?? *.1?? *.2?? *.3??');
  265.       packeddiff:=Cfg.Nodelist+sr.name;
  266.       Changedir(olddir);
  267.     END ELSE
  268.       PackedDiff:='';
  269.     FindClose(Sr);
  270.     IF ExistFile(DiffName) THEN
  271.     BEGIN
  272.       WriteLn('Updating nodelist with '+JustFileName(DiffName));
  273.       BufSize:=Max64k((MaxAvail-1024) DIV 5);
  274.       IF BufSize>32760 THEN BufSize:=32760;
  275.  
  276.       Ind.Init(OldNLName, SOpenRead, BufSize*2);
  277.       Ud.Init(Cfg.Nodelist+'PORTAL.$$$', SCreate, BufSize*2);
  278.       NodeDiff.Init(DiffName, SOpenRead, BufSize);
  279.  
  280.       WHILE NOT NodeDiff.EoF DO
  281.       BEGIN
  282.         NodeDiff.ReadLn(s);
  283.         IF (s<>'') AND (s[1] IN ['A','C','D']) THEN
  284.         BEGIN
  285.           Val(Copy(s,2,255),x,test);
  286.           CASE s[1] OF
  287.             'A' : FOR i:=1 TO x DO
  288.                   BEGIN
  289.                     NodeDiff.ReadLn(s);
  290.                     Ud.WriteLn(s);
  291.                   END;
  292.             'C' : FOR i:=1 TO x DO
  293.                   BEGIN
  294.                     Ind.ReadLn(s);
  295.                     Ud.WriteLn(s);
  296.                   END;
  297.             'D' : FOR i:=1 TO x DO
  298.                     Ind.ReadLn(s);
  299.           END;
  300.         END;
  301.       END;
  302.       NodeDiff.Done;
  303.       Ind.Done;
  304. {      Ch:=#26;
  305.       Ud.Write(Ch, 1);}
  306.       Ud.Done;
  307.  
  308.       IF NodeListSegRec.CheckCRC THEN
  309.       BEGIN
  310.         WriteLn('Calculating CRC');
  311.         GoodCrc:=GoodNLCRC;
  312.       END ELSE GoodCrc:=TRUE;
  313.       IF DeleteFile(DiffName) THEN WriteLn('Erasing '+JustFileName(diffname));
  314.       IF NOT GoodCRC THEN
  315.       BEGIN
  316.         WriteLn('CRC Error on update');
  317.         BadName:=UniqueName(ForceExtension(PackedDiff,'BAD'));
  318.         AddLog('!','CRC Error in nodelist '+JustFileName(diffname)+' renamed to '+JustFileName(BadName));
  319.         DeleteFile(Cfg.NodeList+'PORTAL.$$$');
  320.         RenameFile(PackedDiff,BadName);
  321.         ProcessNodeDiff:=False;
  322.         Exit;
  323.       END;
  324.       IF DeleteFile(packeddiff) THEN WriteLn('Erasing '+JustFileName(packeddiff));
  325.     END;
  326.     IF ExistFile(Cfg.NodeList+'PORTAL.$$$') THEN
  327.     BEGIN
  328.       s:=Cfg.Nodelist+NodeListSegRec.NodeListName+'.'+LongIntForm('@@@',newnum);
  329.       IF RenameFile(cfg.nodelist+'PORTAL.$$$',s) THEN
  330.       BEGIN
  331.         IF DeleteFile(oldnlname) THEN oldnlname:=s;
  332.         IF NodeListSegRec.NewNLPath<>'' THEN
  333.         BEGIN
  334.           WriteLn('Packing new nodelist');
  335.           ChangeDir(JustPathName(Cfg.Nodelist));
  336.           ArcCommand(1,1,AddBackSlash(NodeListSegRec.NewNLPath)+NodeListSegRec.NodeListName+
  337.                                       '.A'+LongIntForm('@@',newnum MOD 100),
  338.                          NodeListSegRec.NodeListName+'.'+LongIntForm('@@@',newnum));
  339.           ChangeDir(StartPath);
  340.           AddToFilesBBS(NodeListSegRec.NodeListName+'.A'+LongIntForm('@@', NewNum MOD 100),
  341.                         NodeListSegRec.NodeListName+'.A'+LongIntForm('@@', Num MOD 100));
  342.         END;
  343.       END;
  344.       num:=newnum;
  345.       GOTO LookForMore;
  346.     END;
  347.     ProcessNodeDiff:=Found;
  348.   END;
  349.  
  350.   PROCEDURE ProcessNodeList;
  351.     TYPE
  352.       tblock = array[0..511] of char;   { indsat BK'94 }
  353.  
  354.  
  355.   VAR
  356.     DoingService,First,FirstRec : Boolean;
  357.     FidoUserLst,f  : TBufTextFile;
  358.     FidoBuf,
  359.  
  360.     i, OldZone     : INTEGER;
  361.     nettitle,
  362.     oldnettitle,
  363.     keyword,ss     : STRING;
  364.     MaxBufSize     : LongInt;
  365.     f1,f2          : BufIdStream;
  366.     QNLI           : QBBSNodeIdxRecord;
  367.     V6             : NewNodeList;
  368.     V6I            : NewNodeListIndex;
  369.     FidoArraySize,
  370.     OldSLength,
  371.     CurNLPos,Use   : LongInt;
  372.     FileNum        : BYTE;
  373.     CurAdr         : TFidoAddress;
  374.     InclTab,ExclTab: SendToTabType;
  375.     currentplace_in_ndx : longint;  { indsat BK'94 }
  376.     instring       : s160; { indsat BK'94 }
  377.     inlength,v7num       : word; { indsat BK'94 }
  378.     conblock       : tblock; { indsat BK'94 }
  379.     controlblock   : ctlblock absolute conblock ;   { indsat BK'94 }
  380.     tempblock      : tblock;
  381.  
  382.  
  383.     PROCEDURE AddFileNum(CONST s: S12; First: Boolean);
  384.     VAR
  385.       f  : FILE OF NodeExtra;
  386.       sr : SearchRec;
  387.     BEGIN
  388.       Assign(f, Cfg.NodeList+ListExtension('NODEINC.'));
  389.       FileMode:=ShareWrite+ShareDenyRW;
  390.       Reset(f);
  391.       IF (IOResult<>0) OR (First) THEN ReWrite(f) ELSE Seek(f,FileSize(f));
  392.       Inc(FileNum);
  393.       FindFirst(Cfg.NodeList+s,Archive,sr);
  394.       FindClose(sr);
  395.       RE.name:=s;
  396.       RE.time:=sr.time;
  397.       Write(f,RE);
  398.       Close(f);
  399.     END;
  400.  
  401.     PROCEDURE ProcessNodeListLine(s: STRING);
  402.     TYPE
  403.       tblock = array[0..511] of char;   { indsat BK'94 }
  404.     VAR
  405.       IsZone,IsHost,
  406.       IsHub,IsDown,
  407.       IsPvt,IsHold,
  408.       IsCrash,IsPoint,
  409.       IsRegion       : BOOLEAN;
  410.       BossPhone,
  411.       OurPhonenumber : S40;
  412.       OurSysOp,
  413.       OurMiscInfo,
  414.       OurSystemName  : S60;
  415.       OurCost,
  416.       CurBaudRate    : WORD;
  417.       OurModemType   : Byte;
  418.       Ch             : CHAR;
  419.       i              : Integer;
  420.       block          : tblock;        { indsat BK'94 }
  421.       leafblock      : LNodeBlk ABSOLUTE block;   { indsat BK'94 }
  422.  
  423.  
  424.       PROCEDURE QBBSNode;
  425.       VAR
  426.         QI : QBBSNodeIdxRecord;
  427.       BEGIN
  428.         FillChar(QI,SizeOf(QI),0);
  429.         QI.RawFile:=FileNum;
  430.         IF IsZone THEN
  431.         BEGIN
  432.           QI.Number:=CurAdr.Zone;
  433.           QI.NodeType:=ntZone;
  434.         END ELSE
  435.         BEGIN
  436.           QI.Number:=CurAdr.Net;
  437.           IF IsRegion THEN QI.NodeType:=ntRegion ELSE QI.NodeType:=ntNet;
  438.         END;
  439.         QI.RawPos:=CurNLPos;
  440.         QI.Cost:=OurCost;
  441.         f2.Write(QI, SizeOf(QI));
  442.       END;
  443.  
  444.       PROCEDURE NewNode;
  445.       BEGIN
  446.         FillChar(V6,SizeOf(V6),0);
  447.         WITH V6 DO
  448.         BEGIN
  449.           IF CurAdr.Zone=OldZone THEN
  450.           BEGIN
  451.             NetNumber:=CurAdr.Net;
  452.             NodeNumber:=CurAdr.Node;
  453.           END ELSE
  454.           BEGIN
  455.             NodeNumber:=-2;
  456.             NetNumber:=CurAdr.Zone;
  457.             OldZone:=CurAdr.Zone;
  458.           END;
  459.           IF IsPoint THEN HubNode:=CurAdr.Point;
  460.           Str2AsciiZ(OurSystemName,SystemName,34);
  461.           Str2AsciiZ(OurMiscInfo,MiscInfo,30);
  462.           cost:=OurCost;
  463.           realcost:=cost;
  464.           Str2AsciiZ(OurPhoneNumber,PhoneNumber,40);
  465.           baudrate:=CurBaudRate DIV 300;
  466.           IF IsPoint THEN
  467.           BEGIN
  468.             V6I.Net:=-1;
  469.             V6I.Node:=CurAdr.Point;
  470.           END ELSE
  471.           BEGIN
  472.             V6I.Net:=NetNumber;
  473.             V6I.Node:=NodeNumber;
  474.           END;
  475.           IF IsHost THEN nodeflags:=nodeflags OR 2 ELSE
  476.             IF IsHub THEN nodeflags:=nodeflags OR 1 ELSE
  477.               IF IsRegion THEN
  478.               BEGIN
  479.                 nodeflags:=nodeflags OR 4;
  480.                 V6I.Node:=-1;
  481.               END;
  482.           IF IsCrash THEN nodeflags:=nodeflags OR 16;
  483.           IF IsPoint THEN NodeFlags:=NodeFlags Or 4096;
  484.           ModemType:=OurModemType;
  485.         END;
  486.         f1.Write(V6, SizeOf(V6));
  487.         f2.Write(V6I, SizeOf(V6I));
  488.       END;
  489.  
  490.       PROCEDURE V7Node;
  491.  
  492.       Type
  493.  
  494.         RNode_op_IndexRef = RECORD
  495.                         IndexLen     : byte;       { Length of string            }
  496.                         IndexData    : LONGINT;    { Record number of string     }
  497.                         IndexPtr     : LONGINT;    { Block number of lower index }
  498.                         Node         : STRING [8]; { String to save Nodenumber   }
  499.                       END;
  500.  
  501.         tblock = ARRAY [0..511]    OF CHAR;
  502.         bblock = ARRAY [0..1023]   OF CHAR;
  503.         nblock = ARRAY [0..511]    OF CHAR;
  504.         Stackarray = ARRAY [1..30] OF LONGINT;
  505.  
  506.       VAR
  507.         realdat : realdatrec;
  508.         packline : s160;
  509.         addressline : s160;
  510.  
  511.       FUNCTION CompAddress (VAR ALine, Desire; L,F : CHAR) : INTEGER;
  512.  
  513.       VAR
  514.         Key     : tfidoaddress ABSOLUTE ALine;
  515.         Desired : tfidoaddress ABSOLUTE Desire;
  516.         Count   : BYTE;
  517.         K       : INTEGER;
  518.  
  519.       BEGIN
  520.         Count := 0;
  521.         k := 0;
  522.         REPEAT
  523.           INC (Count);
  524.           CASE Count OF
  525.                1 : BEGIN
  526.                      IF (f > #0) THEN
  527.                        if ( l > #0) then
  528.                          K := Key.zone  - Desired.zone
  529.                        else k := k - desired.zone
  530.                      else if ( l > #0 ) then k := desired.zone;
  531.                    END;
  532.                2 : BEGIN
  533.                      IF (f > #2) THEN
  534.                        if ( l > #2) then
  535.                          K := Key.net  - Desired.net
  536.                        else k := k - desired.net
  537.                      else if (l > #2) then k := desired.net;
  538.                    END;
  539.                3 : BEGIN
  540.                      IF (f > #4) THEN
  541.                        if (l > #4) then
  542.                          K := Key.node - Desired.node
  543.                        else k := k - desired.node
  544.                      else if (l > #4) then k := desired.node;
  545.                    END;
  546.                4 : BEGIN
  547.                      IF (f > #6) THEN
  548.                        if (l > #6) then
  549.                          K := Key.point - Desired.point
  550.                        else k := k - desired.point
  551.                      else if (l > #6) then k := desired.point;
  552.                    END;
  553.           END;  { Case }
  554.         UNTIL (Count = 4) OR (K <> 0);
  555.         CompAddress := K;
  556.       END;
  557.  
  558.       function MakeAddress (Z, Nt, N, P : Word) : S160;
  559.  
  560.       type
  561.         NodeType = record       { A node address type }
  562.           Len   : Byte;
  563.           Zone  : Word;
  564.           Net   : Word;
  565.           Node  : Word;
  566.           Point : Word;
  567.         end;
  568.  
  569.       var
  570.         Address : NodeType;
  571.         S2      : S160 absolute Address;
  572.  
  573.       begin
  574.         With Address do
  575.            begin
  576.               Zone := Z;
  577.               Net := Nt;
  578.               Node := N;
  579.               Point := P;
  580.            end;
  581.         address.len := 8;
  582.         with address do
  583.          begin
  584.            if p = 0 then len:=6;
  585.            if n = 0 then len:=6; { original := 4}
  586.            if nt = 0 then len:=2;
  587.            if z = 0 then len:=0;
  588.          end;
  589.         MakeAddress := S2;
  590.       end;
  591.  
  592.  
  593.       PROCEDURE read_block (VAR ver : OpArray; VAR rblock : tblock; number : INTEGER);
  594.       BEGIN
  595.         ver.reta(number,0,rblock);
  596.       END;
  597.  
  598.       PROCEDURE write_block (VAR ver : OpArray; VAR rblock : tblock; number : INTEGER);
  599.       BEGIN
  600.          ver.seta(number,0,rblock);
  601.       END;
  602.  
  603.       function insert_btree(VAR ver : OpArray; incoming : s160) : boolean;
  604.       VAR
  605.         block                : tblock;
  606.         indexblock           : INodeBlk ABSOLUTE block;
  607.         leafblock            : LNodeBlk ABSOLUTE block;
  608.         newblock             : tblock;
  609.         newindexblock        : INodeBlk ABSOLUTE newblock;
  610.         newleafblock         : LNodeBlk ABSOLUTE newblock;
  611.         bigblock             : bblock;
  612.         bigindexblock        : bigindex ABSOLUTE bigblock;
  613.         bigleafblock         : bigleaf  ABSOLUTE bigblock;
  614.  
  615.         Stack_up_count,
  616.         NOde_up_KeyVal,
  617.         Count,
  618.         tempcounter          : byte;
  619.         difference           : INTEGER;
  620.         currentblocknumber   : LONGINT;
  621.         Stack_up             : Stackarray;
  622.         Finish               : BOOLEAN;
  623.         Node_op_IndexRef     : RNode_op_IndexRef;
  624.         inlenght             : integer;
  625.         datavar              : longint;
  626.  
  627.  
  628.       BEGIN
  629.  
  630.       { ***************************************************
  631.         ****  S¢g efter leafblokken til at indsætte i  ****
  632.         *************************************************** }
  633.         datavar := currentplace_in_ndx;
  634.         inlenght := BYTE(incoming[0]);
  635.         currentblocknumber := controlblock.ControlRoot;
  636.         read_block(ver,block, controlblock.ControlRoot);
  637.         Stack_up_count := 1;
  638.         FILLCHAR(Stack_up, SIZEOF (Stackarray), #0);
  639.         Stack_up[Stack_up_count] := controlblock.ControlRoot;
  640.         difference := -1;
  641.         Count := 0;
  642.         WHILE indexblock.IndexFirst <> - 1 DO
  643.           BEGIN
  644.             difference := - 1;
  645.             WHILE ( Count < indexblock.IndexCount ) AND (difference < 0) DO
  646.               BEGIN
  647.                 difference := CompAddress (block[indexblock.IndexRef[Count].IndexOfs],incoming[1],
  648.                                            CHR(indexblock.IndexRef[Count].IndexLen),incoming[0]);
  649.                 IF difference = 0 THEN
  650.                   BEGIN { If K = 0 - we found the address ERROR }
  651.                     insert_btree := false;
  652.                     exit;
  653.                   END
  654.                 ELSE
  655.                   IF difference < 0 THEN INC (Count); { move to right (i.e. Increment count) until difference >= 0 }
  656.               END;
  657.             IF Count = 0 THEN currentblocknumber := indexblock.IndexFirst
  658.             ELSE currentblocknumber := indexblock.IndexRef[Count-1].IndexPtr;
  659.             INC (Stack_up_count);
  660.             Stack_up [Stack_up_count] := currentblocknumber;
  661.             read_block (ver,block, currentblocknumber);
  662.             count := 0;
  663.             difference := - 1;
  664.           END;
  665.  
  666.       { *************************************************************************
  667.         ****  Vi har fundet leafblokken og skal nu til at sætte noden i den  ****
  668.         ************************************************************************* }
  669.         Count := 0;
  670.         difference := -1;
  671.         IF ((((leafblock.indexcount+1) * 8) + 16) < (leafblock.IndexStr - inlenght)) AND (leafblock.IndexCount < 49) THEN
  672.           BEGIN
  673.            { *******************************************************
  674.              ****  Leafblokken er ikke fuld og noden indsættes  ****
  675.              ******************************************************* }
  676.             WHILE ( Count < leafblock.IndexCount ) AND (difference < 0) DO
  677.               BEGIN { Find ud af hvor noden skal indsættes, resultat i count }
  678.                 difference := CompAddress(block[leafblock.LeafRef[Count].KeyOfs],incoming[1],
  679.                 CHR(leafblock.LeafRef[Count].KeyLen),incoming[0]);
  680.                 IF difference = 0 THEN
  681.                   BEGIN { If K = 0 - we found the address ERROR }
  682.                     insert_btree := false;
  683.                     exit;
  684.                   END
  685.                 ELSE
  686.                   IF difference < 0 THEN INC (Count); { move to right (i.e. Increment count) until difference >= 0 }
  687.               END; { Vi har nu fundet stedet hvor vi skal indsætte noden }
  688.             INC (leafblock.IndexCount);
  689.             FOR tempcounter := leafblock.IndexCount-1 DOWNTO Count+1 DO
  690.               BEGIN
  691.                 leafblock.LeafRef [tempcounter] := leafblock.LeafRef [tempcounter - 1]
  692.               END;
  693.             leafblock.LeafRef [Count] .KeyOfs := leafblock.IndexStr - inlenght;
  694.             leafblock.LeafRef [Count] .KeyLen := inlenght;
  695.             leafblock.LeafRef [Count] .KeyVal := Datavar;
  696.             MOVE(incoming[1],block[leafblock.IndexStr-inlenght],inlenght);
  697.             leafblock.IndexStr := leafblock.IndexStr - inlenght;
  698.             write_block(ver,block,currentblocknumber);
  699.           END
  700.         ELSE
  701.            { **********************************************************************
  702.              ****  Leafblokken er fuld og der skal splittes til to leafblokke  ****
  703.              ********************************************************************** }
  704.           BEGIN
  705.             WHILE ( Count < leafblock.IndexCount ) AND (difference < 0) DO
  706.               BEGIN { Find ud af hvor noden skal indsættes, resultat i count }
  707.                 difference := CompAddress (block [leafblock.LeafRef [Count] .KeyOfs], incoming [1],
  708.                 CHR (leafblock.LeafRef [Count] .KeyLen),incoming[0] );
  709.                 IF difference = 0 THEN
  710.                   BEGIN { If K = 0 - we found the address ERROR }
  711.                     insert_btree := false;
  712.                     exit;
  713.                   END
  714.                 ELSE
  715.                   IF difference < 0 THEN INC (Count); { move to right (i.e. Increment count) until difference >= 0 }
  716.               END; { Vi har nu fundet stedet hvor vi skal indsætte noden }
  717.             FILLCHAR (bigblock, SIZEOF (bblock), #0);
  718.             bigleafblock.IndexStr := 1023;
  719.             bigleafblock.IndexFirst := leafblock.IndexFirst;
  720.             bigleafblock.IndexBLink := leafblock.IndexBLink;
  721.             bigleafblock.IndexFLink := leafblock.IndexFLink;
  722.             bigleafblock.indexcount := leafblock.indexcount+1;
  723.             tempcounter := 0;
  724.             while  tempcounter <= (Count-1) DO
  725.               BEGIN
  726.                 bigleafblock.LeafRef [tempcounter] .KeyOfs := bigleafblock.IndexStr - leafblock.LeafRef [tempcounter] .KeyLen;
  727.                 bigleafblock.IndexStr := bigleafblock.IndexStr - leafblock.LeafRef [tempcounter] .KeyLen;
  728.                 bigleafblock.LeafRef [tempcounter] .KeyLen := leafblock.LeafRef [tempcounter] .KeyLen;
  729.                 bigleafblock.LeafRef [tempcounter] .KeyVal := leafblock.LeafRef [tempcounter] .KeyVal;
  730.                 MOVE(block [leafblock.LeafRef [tempcounter] .KeyOfs], bigblock [bigleafblock.LeafRef [tempcounter] .KeyOfs],
  731.                      bigleafblock.LeafRef [tempcounter] .KeyLen);
  732.                 inc(tempcounter);
  733.               END;
  734.             bigleafblock.LeafRef [Count] .KeyOfs := bigleafblock.IndexStr - inlenght;
  735.             bigleafblock.LeafRef[Count].KeyLen := inlenght;
  736.             bigleafblock.LeafRef [Count] .KeyVal := Datavar;
  737.             MOVE (incoming [1], bigblock [bigleafblock.IndexStr - inlenght], inlenght);
  738.                   bigleafblock.IndexStr := bigleafblock.IndexStr - inlenght;
  739.             FOR tempcounter := Count TO bigleafblock.IndexCount-2 DO
  740.               BEGIN
  741.                 bigleafblock.LeafRef [tempcounter + 1] .KeyOfs := bigleafblock.IndexStr-leafblock.LeafRef[tempcounter].KeyLen;
  742.                 bigleafblock.IndexStr := bigleafblock.IndexStr - leafblock.LeafRef [tempcounter] .KeyLen;
  743.                 bigleafblock.LeafRef [tempcounter + 1] .KeyLen := leafblock.LeafRef [tempcounter] .KeyLen;
  744.                 bigleafblock.LeafRef [tempcounter + 1] .KeyVal := leafblock.LeafRef [tempcounter] .KeyVal;
  745.                 MOVE (block [leafblock.LeafRef [tempcounter] .KeyOfs], bigblock[bigleafblock.LeafRef[tempcounter+1].KeyOfs],
  746.                       bigleafblock.LeafRef [tempcounter + 1] .KeyLen);
  747.               END;
  748.             FILLCHAR (newblock, SIZEOF (tblock), #0);
  749.             FILLCHAR (leafblock, SIZEOF (tblock), #0);
  750.             leafblock.IndexStr := 511;
  751.             NOde_up_KeyVal := bigleafblock.IndexCount - 6;  { original 8}
  752.             FOR tempcounter := 0 TO NOde_up_KeyVal-2 DO
  753.               BEGIN
  754.                 leafblock.LeafRef[tempcounter].KeyOfs := leafblock.IndexStr - bigleafblock.LeafRef[tempcounter].KeyLen;
  755.                 leafblock.LeafRef[tempcounter].KeyLen := bigleafblock.LeafRef[tempcounter].KeyLen;
  756.                 leafblock.LeafRef[tempcounter].KeyVal := bigleafblock.LeafRef[tempcounter].KeyVal;
  757.                 MOVE(bigblock[bigleafblock.LeafRef[tempcounter].KeyOfs],block[leafblock.IndexStr -
  758.                       leafblock.LeafRef [tempcounter] .KeyLen], leafblock.LeafRef [tempcounter] .KeyLen);
  759.                 leafblock.IndexStr := leafblock.IndexStr - leafblock.LeafRef[tempcounter].KeyLen;
  760.               END;
  761.             leafblock.indexcount := NOde_up_KeyVal-1;
  762.             newleafblock.IndexStr := 511;
  763.             FOR tempcounter := NOde_up_KeyVal-1 TO  bigleafblock.IndexCount-1 DO
  764.               BEGIN
  765.                 newleafblock.LeafRef[tempcounter-(NOde_up_KeyVal-1)].KeyOfs := newleafblock.IndexStr
  766.                   - bigleafblock.LeafRef[tempcounter].KeyLen;
  767.                 newleafblock.LeafRef[tempcounter-(NOde_up_KeyVal-1)].KeyLen := bigleafblock.LeafRef[tempcounter].KeyLen;
  768.                 newleafblock.LeafRef[tempcounter-(NOde_up_KeyVal-1)].KeyVal := bigleafblock.LeafRef[tempcounter].KeyVal;
  769.                 MOVE(bigblock[bigleafblock.LeafRef[tempcounter].KeyOfs],newblock[newleafblock.LeafRef[tempcounter
  770.                      -(NOde_up_KeyVal-1)].KeyOfs],bigleafblock.LeafRef[tempcounter].KeyLen);
  771.                 newleafblock.IndexStr := newleafblock.IndexStr-newleafblock.LeafRef[tempcounter-(NOde_up_KeyVal-1)].KeyLen;
  772.               END;
  773.             newleafblock.indexcount := (bigleafblock.IndexCount - NOde_up_KeyVal)+1;
  774.             leafblock.IndexFirst := - 1;
  775.             INC (controlblock.ControlHiBlock);
  776.             controlblock.ControlHighLeaf := controlblock.controlhiblock +1;
  777.             leafblock.IndexBLink := bigleafblock.IndexBLink;
  778.             leafblock.IndexFLink := controlblock.ControlHiBlock;
  779.             newleafblock.IndexFirst := - 1;
  780.             newleafblock.IndexBLink := currentblocknumber;
  781.             newleafblock.IndexFLink := bigleafblock.IndexFLink;
  782.             write_block (ver,block, currentblocknumber);
  783.             IF newleafblock.IndexFLink <> 0 THEN
  784.               BEGIN
  785.                 read_block (ver,Block, newleafblock.IndexFLink);
  786.                 leafBlock.IndexBLink := controlblock.ControlHiBlock;
  787.                 write_block (ver,Block, newleafblock.IndexFLink);
  788.               END;
  789.             write_block (ver,newblock, controlblock.ControlHiBlock);
  790.             Node_op_IndexRef.IndexLen := bigleafblock.LeafRef [NOde_up_KeyVal-1] .KeyLen;
  791.             Node_op_IndexRef.IndexData := bigleafblock.LeafRef [NOde_up_KeyVal-1] .KeyVal;
  792.             Node_op_IndexRef.IndexPtr := controlblock.ControlHiBlock;
  793.             node_op_indexref.node[0] := chr(Node_op_IndexRef.IndexLen);
  794.             MOVE(bigblock[bigleafblock.LeafRef[NOde_up_KeyVal-1].KeyOfs], Node_op_IndexRef.node[1],
  795.                   Node_op_IndexRef.IndexLen);
  796.  
  797.            { **********************************************************************
  798.              ****  Node_op_indexRef skal nu indsættes i indexblokkene          ****
  799.              ********************************************************************** }
  800.  
  801.  
  802.             Finish := FALSE;
  803.             REPEAT
  804.               IF Stack_up_count = 1 THEN
  805.                 BEGIN
  806.  
  807.                    { ****************************************************
  808.                      ****  Der oprettes en ny root i træ'et          ****
  809.                      **************************************************** }
  810.  
  811.                   FILLCHAR(newblock,SIZEOF(newblock),#0);
  812.                   newindexblock.IndexFirst := currentblocknumber;
  813.                   newindexblock.IndexBLink := 0;
  814.                   newindexblock.IndexFLink := 0;
  815.                   newindexblock.IndexCount := 1;
  816.                   newindexblock.IndexStr := 511;
  817.                   newindexblock.IndexRef[0].IndexLen := Node_op_IndexRef.IndexLen;
  818.                   newindexblock.IndexRef[0].IndexData := Node_op_IndexRef.IndexData;
  819.                   newindexblock.IndexRef[0].IndexPtr := Node_op_IndexRef.IndexPtr;
  820.                   newindexblock.IndexRef[0].IndexOfs := newindexblock.IndexStr - newindexblock.IndexRef[0].IndexLen;
  821.                   newindexblock.IndexStr := newindexblock.IndexStr - Node_op_indexref.indexlen;
  822.                   MOVE(Node_op_IndexRef.node[1],newblock[newindexblock.IndexRef[0].IndexOfs],
  823.                         Node_op_IndexRef.IndexLen);
  824.                   INC (controlblock.ControlHiBlock);
  825.                   controlblock.ControlRoot := controlblock.ControlHiBlock;
  826.                   INC (controlblock.ControlLevels);
  827.                   write_block (ver,newblock, controlblock.ControlHiBlock);
  828.                   Finish := TRUE;
  829.                 END
  830.               ELSE
  831.                 BEGIN
  832.                   DEC (Stack_up_count);
  833.                   read_block (ver,block, Stack_up[Stack_up_count]);
  834.                   IF ((((indexblock.indexcount+1)*12)+16) < (indexblock.IndexStr - inlenght))
  835.                      AND (indexblock.IndexCount <= 49) THEN
  836.                     BEGIN { indexblokken er ikke fuld og noden indsættes }
  837.  
  838.                        { ********************************************************
  839.                          ****  indexblokken er ikke fuld og noden indsættes  ****
  840.                          ******************************************************** }
  841.                       Count := 0;
  842.                       difference := -1;
  843.                       WHILE ( Count < indexblock.IndexCount ) AND (difference < 0) DO
  844.                         BEGIN { Find ud af hvor noden skal indsættes, resultat i count }
  845.                           difference := CompAddress(block[indexblock.IndexRef[Count].IndexOfs],Node_op_IndexRef.node[1],
  846.                           CHR (indexblock.IndexRef[Count].IndexLen),Node_op_IndexRef.node[0]);
  847.                           IF difference = 0 THEN
  848.                             BEGIN { If K = 0 - we found the address ERROR }
  849.                               insert_btree := false;
  850.                               exit;
  851.                             END
  852.                           ELSE
  853.                             IF difference < 0 THEN INC (Count); { move to right (i.e. Increment count) until difference >= 0 }
  854.                         END; { Vi har nu fundet stedet hvor vi skal indsætte noden }
  855.                       INC (indexblock.IndexCount);
  856.                       FOR tempcounter := indexblock.IndexCount-1 DOWNTO Count+1 DO
  857.                         BEGIN
  858.                           indexblock.IndexRef [tempcounter] := indexblock.IndexRef [tempcounter - 1]
  859.                         END;
  860. {                      IF count <> 0 Then
  861.                         Begin}
  862.                           indexblock.IndexRef [Count] .IndexOfs := indexblock.IndexStr - Node_op_indexref.indexlen;
  863.                           indexblock.IndexRef [Count] .IndexLen := Node_op_indexref.indexlen;
  864.                           indexblock.IndexRef [Count] .IndexData := Node_op_indexref.indexdata;
  865.                           indexblock.IndexRef [Count] .IndexPtr := Node_op_indexref.indexPtr;
  866.                           MOVE (Node_op_IndexRef.node[1],block[indexblock.IndexStr-Node_op_indexref.indexlen],
  867.                                 Node_op_IndexRef.IndexLen);
  868.                           indexblock.IndexStr := indexblock.IndexStr-Node_op_indexref.indexlen;
  869. {                        End
  870.                       Else
  871.                         Begin
  872.                           indexblock.IndexRef[Count].IndexPtr := indexblock.indexfirst;
  873.                           indexblock.IndexRef [Count] .IndexOfs := indexblock.IndexStr - Node_op_indexref.indexlen;
  874.                           indexblock.IndexRef [Count] .IndexLen := Node_op_indexref.indexlen;
  875.                           indexblock.IndexRef [Count] .IndexData := Node_op_indexref.indexdata;
  876.                           indexblock.Indexfirst := Node_op_indexref.indexPtr;
  877.                           MOVE (Node_op_IndexRef.node[1],block[indexblock.IndexStr-Node_op_indexref.indexlen],
  878.                                 Node_op_IndexRef.IndexLen);
  879.                           indexblock.IndexStr := indexblock.IndexStr - Node_op_indexref.indexlen;
  880.                         End; }
  881.                       write_block (ver,block, Stack_up [Stack_up_count]);
  882.                       Finish := TRUE;
  883.                     END
  884.                   ELSE
  885.                     BEGIN
  886.  
  887.                          { ************************************************************************
  888.                            ****  indexblokken er fuld og der skal splittes til to indexblokke  ****
  889.                            ************************************************************************ }
  890.  
  891.                       Count := 0;
  892.                       difference := -1;
  893.                       WHILE ( Count < indexblock.IndexCount ) AND (difference < 0) DO
  894.                         BEGIN { Find ud af hvor noden skal indsættes, resultat i count }
  895.                           difference := CompAddress(block[indexblock.IndexRef[Count].IndexOfs],Node_op_IndexRef.node[1],
  896.                           CHR(indexblock.IndexRef[Count].IndexLen),Node_op_IndexRef.node[0]);
  897.                           IF difference = 0 THEN
  898.                             BEGIN { If K = 0 - we found the address ERROR }
  899.                               insert_btree := false;
  900.                               exit;
  901.                             END
  902.                           ELSE
  903.                             IF difference < 0 THEN INC (Count); { move to right (i.e. Increment count) until difference >= 0 }
  904.                         END; { Vi har nu fundet stedet hvor vi skal indsætte noden }
  905.                       FILLCHAR(bigblock,SIZEOF(bblock),#0);
  906.                       bigindexblock.IndexStr := 1023;
  907.                       bigindexblock.IndexFirst := indexblock.IndexFirst;
  908.                       bigindexblock.IndexBLink := indexblock.IndexBLink;
  909.                       bigindexblock.IndexFLink := indexblock.IndexFLink;
  910.                       bigindexblock.IndexCount := indexblock.IndexCount+1;
  911.                       tempcounter := 0;
  912.                       while tempcounter <= (Count-1) DO
  913.                         BEGIN
  914.                           bigindexblock.IndexRef[tempcounter].IndexOfs :=
  915.                             bigindexblock.IndexStr-indexblock.IndexRef[tempcounter].IndexLen;
  916.                           bigindexblock.IndexStr := bigindexblock.IndexStr - indexblock.IndexRef[tempcounter].IndexLen;
  917.                           bigindexblock.IndexRef[tempcounter].IndexLen := indexblock.IndexRef[tempcounter].IndexLen;
  918.                           bigindexblock.IndexRef[tempcounter].IndexData := indexblock.IndexRef[tempcounter].IndexData;
  919.                           bigindexblock.IndexRef[tempcounter].IndexPtr := indexblock.IndexRef[tempcounter].IndexPtr;
  920.                           MOVE (block [indexblock.IndexRef [tempcounter] .IndexOfs],
  921.                                 bigblock [bigindexblock.IndexRef [tempcounter]
  922.                                .IndexOfs], bigindexblock.IndexRef [tempcounter] .IndexLen);
  923.                           inc(tempcounter);
  924.                         END;
  925.                       bigindexblock.IndexRef[Count].IndexOfs := bigindexblock.IndexStr - Node_op_indexref.indexlen;
  926.                       bigindexblock.IndexRef[Count].IndexLen := Node_op_indexref.indexlen;
  927.                       bigindexblock.IndexRef[Count].IndexData := Node_op_indexref.indexdata;
  928.                       bigindexblock.IndexRef[Count].IndexPtr := Node_op_indexref.indexPtr;
  929.                       MOVE (Node_op_IndexRef.node[1],bigblock[bigindexblock.IndexStr-Node_op_IndexRef.IndexLen],
  930.                             Node_op_IndexRef.IndexLen);
  931.                       bigindexblock.IndexStr := bigindexblock.IndexStr - Node_op_indexref.indexlen;
  932.                       FOR tempcounter := Count TO bigindexblock.IndexCount -2 DO
  933.                         BEGIN
  934.                           bigindexblock.IndexRef[tempcounter+1].IndexOfs := bigindexblock.IndexStr
  935.                             -indexblock.IndexRef[tempcounter].IndexLen;
  936.                           bigindexblock.IndexStr := bigindexblock.IndexStr-indexblock.IndexRef[tempcounter].IndexLen;
  937.                           bigindexblock.IndexRef[tempcounter+1].IndexLen := indexblock.IndexRef[tempcounter].IndexLen;
  938.                           bigindexblock.indexref[tempcounter+1].indexptr := indexblock.IndexRef[tempcounter].Indexptr;
  939.                           bigindexblock.IndexRef[tempcounter+1].IndexData := indexblock.IndexRef[tempcounter].IndexData;
  940.                           MOVE (block[indexblock.IndexRef[tempcounter].IndexOfs],
  941.                                 bigblock[bigindexblock.IndexRef[tempcounter+1].IndexOfs],
  942.                                 bigindexblock.IndexRef[tempcounter+1].IndexLen);
  943.                         END;
  944.                       FILLCHAR(newblock,SIZEOF(tblock),#0);
  945.                       FILLCHAR(indexblock,SIZEOF(tblock),#0);
  946.                       indexblock.IndexStr:=511;
  947.                       node_up_keyval := bigindexblock.IndexCount -8;
  948.                       indexblock.indexfirst := bigindexblock.indexfirst;
  949.                       FOR tempcounter := 0 TO node_up_keyval-2 DO
  950.                         BEGIN
  951.                           indexblock.IndexRef[tempcounter].IndexOfs  := indexblock.IndexStr
  952.                             - bigindexblock.IndexRef[tempcounter].IndexLen;
  953.                           indexblock.IndexRef[tempcounter].IndexLen  := bigindexblock.IndexRef[tempcounter].IndexLen;
  954.                           indexblock.IndexRef[tempcounter].IndexData := bigindexblock.IndexRef[tempcounter].IndexData;
  955.                           indexblock.IndexRef[tempcounter].IndexPtr  := bigindexblock.IndexRef[tempcounter].IndexPtr;
  956.                           MOVE (bigblock[bigindexblock.IndexRef[tempcounter].IndexOfs],
  957.                                 block[indexblock.IndexRef[tempcounter].IndexOfs],indexblock.IndexRef[tempcounter].IndexLen);
  958.                           indexblock.IndexStr := indexblock.IndexStr - indexblock.IndexRef[tempcounter].IndexLen;
  959.                         END;
  960.                       indexblock.indexcount := node_up_keyval-1;
  961.                       newindexblock.IndexStr:=511;
  962.                       newindexblock.indexfirst := bigindexblock.indexRef[NOde_up_KeyVal-1].indexptr;
  963.                       FOR tempcounter := node_up_keyval TO bigindexblock.IndexCount-1 DO
  964.                         BEGIN
  965.                           newindexblock.IndexRef[tempcounter-node_up_keyval].IndexOfs := newindexblock.IndexStr
  966.                             - bigindexblock.IndexRef[tempcounter].IndexLen;
  967.                           newindexblock.IndexRef[tempcounter-node_up_keyval].IndexLen
  968.                             := bigindexblock.IndexRef[tempcounter].IndexLen;
  969.                           newindexblock.IndexRef[tempcounter-node_up_keyval].IndexData
  970.                             := bigindexblock.IndexRef[tempcounter].IndexData;
  971.                           newindexblock.IndexRef[tempcounter-node_up_keyval].IndexPtr
  972.                             := bigindexblock.IndexRef[tempcounter].IndexPtr;
  973.                           MOVE(bigblock[bigindexblock.IndexRef[tempcounter].IndexOfs],
  974.                                newblock[newindexblock.IndexRef[tempcounter-node_up_keyval].IndexOfs],
  975.                                bigindexblock.IndexRef[tempcounter].IndexLen);
  976.                           newindexblock.IndexStr := newindexblock.IndexStr-
  977.                             newindexblock.IndexRef[tempcounter-node_up_keyval].IndexLen;
  978.                         END;
  979.                       newindexblock.indexcount := bigindexblock.indexcount - node_up_keyval;
  980.                       currentblocknumber := Stack_up[Stack_up_count];
  981.                       INC (controlblock.ControlHiBlock);
  982.                       indexblock.IndexBLink := bigindexblock.IndexBLink;
  983.                       indexblock.IndexFLink := controlblock.ControlHiBlock;
  984.                       newindexblock.IndexBLink := currentblocknumber;
  985.                       newindexblock.IndexFLink := bigindexblock.IndexFLink;
  986.                       write_block (ver,block, currentblocknumber);
  987.                       IF newindexblock.IndexFLink <> 0 THEN
  988.                         BEGIN
  989.                           read_block (ver,Block, newindexblock.IndexFLink);
  990.                           indexBlock.IndexBLink := controlblock.ControlHiBlock;
  991.                           write_block (ver,Block, newindexblock.IndexFLink);
  992.                         END;
  993.                       write_block(ver,newblock, controlblock.ControlHiBlock);
  994.                       Node_op_IndexRef.IndexLen := bigindexblock.indexRef[NOde_up_KeyVal-1].indexLen;
  995.                       Node_op_IndexRef.IndexData := bigindexblock.indexRef[NOde_up_KeyVal-1].indexdata;
  996.                       Node_op_IndexRef.IndexPtr := controlblock.ControlHiBlock;
  997.                       node_op_indexref.node[0] := chr(Node_op_IndexRef.IndexLen);
  998.                       MOVE(bigblock[bigindexblock.indexRef[NOde_up_KeyVal-1].indexOfs],Node_op_IndexRef.node[1],
  999.                            Node_op_IndexRef.IndexLen);
  1000.                     END;
  1001.                 END;
  1002.             UNTIL Finish;
  1003.           End;
  1004.         insert_btree := true;
  1005.       END;
  1006.  
  1007.  
  1008.       BEGIN { write nodex.dat og nodex.ndx evt sysop.ndx}
  1009.         packline :='';
  1010.         packline := oursystemname + oursysop + ourmiscinfo;
  1011.         packline := pack(packline);
  1012.         with realdat do
  1013.          begin
  1014.            zone := curadr.zone;
  1015.            net  := curadr.net;
  1016.            node := curadr.node;
  1017.            point := curadr.point;
  1018.            callcost := ourcost;
  1019.            msgfee :=  0;
  1020.            nodeflags := 0;
  1021.            IF IsHost THEN nodeflags:=nodeflags OR 2
  1022.             ELSE
  1023.               IF IsHub THEN nodeflags:=nodeflags OR 1
  1024.                ELSE
  1025.                 IF IsRegion THEN nodeflags:=nodeflags OR 4;
  1026.            IF IsCrash THEN nodeflags:=nodeflags OR 16;
  1027.            IF IsPoint THEN NodeFlags:=NodeFlags Or 4096;
  1028.            modemtype := ourmodemtype;
  1029.            phonelen := length(ourphonenumber);
  1030.            passwordlen := 0;
  1031.            bnamelen := length(oursystemname);
  1032.            snamelen := length(oursysop);
  1033.            cnamelen := length(ourmiscinfo);
  1034.            packlen := length(packline);
  1035.            baud  := curbaudrate div 300;
  1036.          end;
  1037.         addressline := makeaddress(curadr.zone,curadr.net,curadr.node,curadr.point);
  1038.         if insert_btree(v7,addressline) then
  1039.          begin
  1040.            f1.Write(realdat,22);
  1041.            f1.write(ourphonenumber[1],realdat.phonelen);
  1042.            f1.Write(packline[1],realdat.packlen);
  1043.            currentplace_in_ndx := currentplace_in_ndx + 22 + realdat.packlen+realdat.phonelen;
  1044.          end;
  1045. {
  1046.         if sysopindex then
  1047.          begin
  1048.            if insert_btree(v7,addressline) then
  1049.              begin
  1050.              end;
  1051.          end;
  1052. }
  1053.       END;
  1054.  
  1055.       PROCEDURE GetNodeListLineInfo;
  1056.       VAR
  1057.         ss     : STRING;
  1058.         Num,
  1059.         test,i : Integer;
  1060.         w      : SmallWord;
  1061.       BEGIN
  1062.         ss:=StUpCase(NextWord(',',s));
  1063.         IsCrash:=False;
  1064.         IsRegion:=(ss='REGION');
  1065.         IsHost:=(ss='HOST');
  1066.         IsDown:=(ss='DOWN');
  1067.         IsHold:=(ss='HOLD');
  1068.         IsZone:=(ss='ZONE');
  1069.         IsHub:=(ss='HUB');
  1070.         IsPvt:=(ss='PVT');
  1071.         IsPoint:=(ss='POINT');
  1072.         ss:=NextWord(',',s);
  1073.         VAL(ss,Num,test);
  1074.         IF IsPoint THEN
  1075.           CurAdr.Point:=Num
  1076.         ELSE
  1077.           IF IsZone THEN
  1078.           BEGIN
  1079.             DoingService:=TRUE;
  1080.             CurAdr.Zone:=Num;
  1081.             CurAdr.Net:=Num;
  1082.             CurAdr.Node:=0;
  1083.             CurAdr.Point:=0;
  1084.             HostPhone:='';
  1085.           END ELSE
  1086.             IF IsRegion OR IsHost {OR DoingService} THEN
  1087.             BEGIN
  1088.               DoingService:=False;
  1089.               CurAdr.Net:=Num;
  1090.               CurAdr.Node:=0;
  1091.             END ELSE
  1092.               CurAdr.Node:=Num;
  1093.         OurSystemName:=NextWord(',',s);
  1094.         Replace(OurSystemName,'_',' ',0);
  1095.         IF IsDown THEN OurSystemName:='<'+OurSystemName;
  1096.         OurMiscInfo:=NextWord(',',s);
  1097.         Replace(OurMiscInfo,'_',' ',0);
  1098.         OurSysOp:=NextWord(',',s);
  1099.         Replace(OurSysOp,'_',' ',0);
  1100.         IF OurSystemName=' ' THEN OurSystemName:=OurSysOp;
  1101.         OurPhoneNumber:=NextWord(',',s);
  1102.         IF IsHost THEN HostPhone:=OurPhoneNumber;
  1103.         IF IsDown OR IsHold OR IsPvt THEN OurPhoneNumber:=HostPhone;
  1104.         IF Not IsPoint THEN BossPhone:=OurPhoneNumber;
  1105.         IF StUpCase(OurPhoneNumber)='-UNPUBLISHED-' THEN
  1106.           IF IsPoint THEN OurPhoneNumber:=BossPhone ELSE OurPhoneNumber:=HostPhone;
  1107.         IF NOT (Cfg.NodelistTyp IN [QBBSNodelistType, SBBSNodeListType, RANodeListType]) THEN
  1108.         BEGIN
  1109.           OurCost:=FindCost(OurPhoneNumber);
  1110.           IF NOT IsOurAddress(CurAdr) THEN OurPhoneNumber:=PhoneTranslation(OurPhoneNumber);
  1111.         END;
  1112.         ss:=NextWord(',',s);
  1113.         VAL(ss,CurBaudRate,Test);
  1114.         ss:=StUpCase(s) ;
  1115.         IF NOT (Cfg.NodelistTyp IN [QBBSNodelistType, SBBSNodeListType, RANodeListType]) THEN
  1116.           GetSpecialModemInfo(StUpCase(s), OurModemType, w);
  1117.         REPEAT
  1118.           ss:=StUpCase(NextWord(',',s));
  1119.           IF ss='CM' THEN IsCrash:=True;
  1120.         UNTIL (s='') OR (Length(s)<2);
  1121.       END;
  1122.  
  1123.       FUNCTION CheckAddress(CONST Adr: TFidoAddress; CONST AdrTab: SendToTabType): Boolean;
  1124.       VAR
  1125.         Ok : Boolean;
  1126.         i : Byte;
  1127.       BEGIN
  1128.         Ok:=False; i:=1;
  1129.         WHILE Not Ok And (i<=50) And (AdrTab[i].Zone<>-2) DO
  1130.         BEGIN
  1131.           IF ((AdrTab[i].Zone=-1) Or (AdrTab[i].Zone=Adr.Zone)) And
  1132.              ((AdrTab[i].Net=-1) Or (AdrTab[i].Net=Adr.Net)) And
  1133.              ((AdrTab[i].Node=-1) Or (AdrTab[i].Node=Adr.Node)) THEN
  1134.             Ok:=True
  1135.           ELSE
  1136.             Inc(i);
  1137.         END;
  1138.         CheckAddress:=Ok;
  1139.       END;
  1140.  
  1141.     BEGIN
  1142.       IF First THEN
  1143.       BEGIN
  1144.         First:=False;
  1145.         IF Cfg.NodeListTyp=Version7 THEN { Her indsættes de f¢rste to records i .ndx filen BK'94}
  1146.         BEGIN
  1147.           FILLCHAR(controlblock,512,#0);
  1148.           currentplace_in_ndx := 0;
  1149.           controlblock.ControlBlockSize := 512;
  1150.           controlblock.ControlRoot      := 1;
  1151.           controlblock.ControlHiBlock   := 1;
  1152.           controlblock.ControlLowLeaf   := 1;
  1153.           controlblock.ControlHighLeaf  := 1;
  1154.           controlblock.ControlFree      := 0;
  1155.           controlblock.ControlLevels    := 1;
  1156.           controlblock.ControlParity    := 0;
  1157.           v7.seta(0,0,controlblock);
  1158.           FILLCHAR(block,512,#0);
  1159.           leafblock.IndexFirst := -1;
  1160.           leafblock.IndexBLink := 0;
  1161.           leafblock.IndexFLink := 0;
  1162.           leafblock.IndexCount := 0;
  1163.           leafblock.IndexStr   := 511;
  1164.           v7.seta(1,0,leafblock);
  1165.         END;
  1166.       END;
  1167.       OldSLength:=Length(s);
  1168.       IF s<>'' THEN
  1169.       BEGIN
  1170.         ch:=s[1];
  1171.         IF (ch<>';') AND (ch<>' ') THEN
  1172.         BEGIN
  1173.           s:=s+',';
  1174.           GetNodeListLineInfo;
  1175.           IF IsZone OR IsHost THEN NetTitle:=OurSystemName;
  1176.           IF (IsZone) Or (CheckAddress(CurAdr,InclTab) And Not CheckAddress(CurAdr,ExclTab)) THEN
  1177.           BEGIN
  1178.             IF Cfg.NLCompiler.UseFidoUserLst THEN
  1179.             BEGIN
  1180.               s:=OurSysOp;
  1181.               i:=WordCount(s,[' ']);
  1182.               ss:=ExtractWord(i,s,[' ']);
  1183.               dec(s[0],Length(ss)+1);
  1184.               if i>1 then ss:=ss+', '+s;
  1185.               s:=Address2Str(CurAdr);
  1186.               ss:=CPad(ss,60-Length(s))+s;
  1187.               FidoUser.SetA(FidoUserNum,0,ss);
  1188.               INC(FidoUserNum);
  1189.             END;
  1190.             CASE Cfg.NodeListTyp OF
  1191.               RANodeListType,
  1192.               SBBSNodeListType,
  1193.               QBBSNodeListType : IF IsZone OR IsHost OR IsRegion THEN QBBSNode;
  1194.               NewNodeListType  : NewNode;
  1195.               Version7         : V7Node;
  1196.             END;
  1197.           END;
  1198.           IF Nettitle<>OldNettitle THEN
  1199.           BEGIN
  1200.             s:='('+Long2Str(CurAdr.Zone)+':'+Long2Str(CurAdr.Net)+'/*)  "'+nettitle+'"';
  1201.             s:=CPad(s,59);
  1202.             Temp^.wFastWrite(s,WhereY,1,Cfg.Color[2].highlightcolor);
  1203.             OldNettitle:=Nettitle;
  1204.           END;
  1205.         END;
  1206.       END;
  1207.       INC(CurNlPos,LongInt(OldSLength+2));
  1208.     END;
  1209.  
  1210.     FUNCTION SortFidoUser: Boolean;
  1211.     VAR
  1212.       Escaped : Boolean;
  1213.  
  1214.       procedure QuickSort(L, R : Word);
  1215.         {-Non-recursive QuickSort per N. Wirth's "Algorithms and Data Structures"}
  1216.       const
  1217.         StackSize = 20;
  1218.       type
  1219.         Stack = array[1..StackSize] of Word;
  1220.       var
  1221.         Lstack : Stack;          {Pending partitions, left edge}
  1222.         Rstack : Stack;          {Pending partitions, right edge}
  1223.         StackP : Integer;        {Stack pointer}
  1224.         Pl : Word;               {Left edge within partition}
  1225.         Pr : Word;               {Right edge within partition}
  1226.         StrPl, StrPr, Pivot : S62;
  1227.       begin
  1228.         {Initialize the stack}
  1229.         StackP := 1;
  1230.         Lstack[1] := L;
  1231.         Rstack[1] := R;
  1232.         Write('>>');
  1233.  
  1234.         {Repeatedly take top partition from stack}
  1235.         repeat
  1236.  
  1237.           {Pop the stack}
  1238.           L := Lstack[StackP];
  1239.           R := Rstack[StackP];
  1240.           Dec(StackP);
  1241.           Write(#8'<'#8);
  1242.  
  1243.           {Sort current partition}
  1244.           repeat
  1245.  
  1246.             {Load the pivot element}
  1247.             FidoUser.RetA(L+Random(R-L), 0, Pivot);
  1248.             Pl := L;
  1249.             Pr := R;
  1250.  
  1251.             {Swap items in sort order around the pivot index}
  1252.             repeat
  1253.               FidoUser.RetA(Pl, 0, StrPl);
  1254.               while StrPl<Pivot do
  1255.               begin
  1256.                 Inc(Pl);
  1257.                 FidoUser.RetA(Pl, 0, StrPl);
  1258.               end;
  1259.               FidoUser.RetA(Pr, 0, StrPr);
  1260.               while StrPr>Pivot do
  1261.               begin
  1262.                 Dec(Pr);
  1263.                 FidoUser.RetA(Pr, 0, StrPr);
  1264.               end;
  1265.               if Pl <= Pr then
  1266.               begin
  1267.                 if Pl <> Pr then
  1268.                 begin
  1269.                   {Swap the two elements}
  1270.                   FidoUser.SetA(Pl, 0, StrPr);
  1271.                   FidoUser.SetA(Pr, 0, StrPl);
  1272.                 end;
  1273.                 if Pl < 65535 then Inc(Pl);
  1274.                 if Pr > 0 then Dec(Pr);
  1275.               end;
  1276.               Escaped:=GotEsc;
  1277.               IF Escaped THEN Exit;
  1278.             until Pl > Pr;
  1279.  
  1280.             {Decide which partition to sort next}
  1281.             if (Pr-L) < (R-Pl) then
  1282.             begin
  1283.               {Left partition is bigger}
  1284.               if Pl < R then
  1285.               begin
  1286.                 {Stack the request for sorting right partition}
  1287.                 Inc(StackP);
  1288.                 Lstack[StackP] := Pl;
  1289.                 Rstack[StackP] := R;
  1290.                 Write('>');
  1291.               end;
  1292.               {Continue sorting left partition}
  1293.               R := Pr;
  1294.             end else
  1295.             begin
  1296.               {Right partition is bigger}
  1297.               if L < Pr then
  1298.               begin
  1299.                 {Stack the request for sorting left partition}
  1300.                 Inc(StackP);
  1301.                 Lstack[StackP] := L;
  1302.                 Rstack[StackP] := Pr;
  1303.                 Write('>');
  1304.               end;
  1305.               {Continue sorting right partition}
  1306.               L := Pl;
  1307.             end;
  1308.           until L >= R;
  1309.         until StackP <= 0;
  1310.         Write(#8'<'#8);
  1311.       end;
  1312.  
  1313.     BEGIN
  1314.       Escaped:=False;
  1315.       Dec(FidoUserNum);
  1316.       QuickSort(0,FidoUserNum);
  1317.       SortFidoUser:=NOT Escaped;
  1318.     END;
  1319.  
  1320.     PROCEDURE DecodeAdr(VAR AdrTab: SendToTabType; AdrStr: SendToType) ;
  1321.     VAR
  1322.       i,j,x : Byte;
  1323.       TmpStr : s20;
  1324.       Err : Integer;
  1325.     BEGIN
  1326.       FillChar(AdrTab, SizeOf(AdrTab), 0);
  1327.       i:=1;
  1328.       FOR j:=1 TO 2 DO
  1329.       BEGIN
  1330.         WHILE AdrStr[j]<>'' DO
  1331.         BEGIN
  1332.           x:=Pos(' ',AdrStr[j]);
  1333.           IF x>0 THEN
  1334.           BEGIN
  1335.             TmpStr:=Copy(AdrStr[j],1,x-1);
  1336.             Delete(AdrStr[j],1,x) ;
  1337.           END ELSE
  1338.           BEGIN
  1339.             TmpStr:=AdrStr[j];
  1340.             AdrStr[j]:='';
  1341.           END;
  1342.           x:=Pos(':',TmpStr);
  1343.           IF StUpCase(Copy(TmpStr,1,x-1))='ALL' THEN
  1344.             AdrTab[i].Zone:=-1
  1345.           ELSE
  1346.             Val(Copy(TmpStr,1,x-1),AdrTab[i].Zone,Err);
  1347.           Delete(TmpStr,1,x);
  1348.           x:=Pos('/',TmpStr);
  1349.           IF StUpCase(Copy(TmpStr,1,x-1))='ALL' THEN
  1350.             AdrTab[i].Net:=-1
  1351.           ELSE
  1352.             Val(Copy(TmpStr,1,x-1),AdrTab[i].Net,Err);
  1353.           Delete(TmpStr,1,x);
  1354.           IF StUpCase(TmpStr)='ALL' THEN
  1355.             AdrTab[i].Node:=-1
  1356.           ELSE
  1357.             Val(TmpStr,AdrTab[i].Node,Err);
  1358.           Inc(i)
  1359.         END;
  1360.       END;
  1361.       AdrTab[i].Zone:=-2;
  1362.     END;
  1363.  
  1364.   BEGIN
  1365.     ReadTranslationTable(False);
  1366.     ReadCostTable(False);
  1367.  
  1368.     IF Cfg.NLCompiler.UseFidoUserLst THEN
  1369.     BEGIN
  1370.       FidoUser.Init(50000, 1, 62, '$FIDOUSR.SRT', Max64k((MaxAvail-2048) DIV 3), lDeleteFile, DefaultPriority);
  1371.       FidoUserNum:=0;
  1372.     END;
  1373.     MaxBufSize:=Max64k((MaxAvail-1024) DIV 3);
  1374.     IF Cfg.NodelistTyp = Version7 Then
  1375.      Begin
  1376.       v7.Init(3000, 1, 512, '$v7nl.SRT', Max64k((MaxAvail-2048) DIV 3), lDeleteFile, DefaultPriority);
  1377.      End;
  1378.     IF NOT (Cfg.NodelistTyp IN [QBBSNodeListType,SBBSNodelistType,RANodeListType]) THEN
  1379.       f1.Init(MakeTaskFileName(Cfg.NodeList+'POP_NL.DAT'), SCreate, Max64k((MaxAvail-MaxBufSize) DIV 10 * 8));
  1380.     f2.Init(MakeTaskFileName(Cfg.NodeList+'POP_NL.IDX'), SCreate, Max64k(MaxAvail-MaxBufSize-2048));
  1381.     FileNum:=0;
  1382.     OldZone:=-1;
  1383.     OldNettitle:='';
  1384.     NetTitle:='';
  1385.     IF Cfg.NodeListTyp=NewNodeListType THEN
  1386.     BEGIN
  1387.       FillChar(V6, SizeOf(V6), 0);
  1388.       V6.NetNumber:=-1;
  1389.       V6.NodeNumber:=6;
  1390.       Str2AsciiZ('Portal of Power',V6.SystemName,34);
  1391.       V6I.Net:=-1;
  1392.       V6I.Node:=6;
  1393.       f1.Write(V6, SizeOf(V6));
  1394.       f2.Write(V6I, SizeOf(V6I));
  1395.     END;
  1396.     FirstRec:=True; First:=True; DoingService:=True;
  1397.     NodeListSegFile.Seek(0);
  1398.     WHILE Not NodeListSegFile.EoF DO
  1399.     BEGIN
  1400.       NodeListSegFile.Read(NodeListSegRec,NoKeep,Wait);
  1401.       IF FindOldNlName(OldNlName,Num) THEN
  1402.       BEGIN
  1403.         WriteLn('Compiling '+JustFileName(oldnlname));
  1404.         f.Init(oldnlname, SOpenRead+ShareDenyNone, MaxBufSize);
  1405.         DecodeAdr(InclTab,NodeListSegRec.Include) ;
  1406.         IF InclTab[1].Zone=-2 THEN
  1407.         BEGIN
  1408.           InclTab[1].Zone:=-1;
  1409.           InclTab[1].Net:=-1;
  1410.           InclTab[1].Node:=-1;
  1411.           InclTab[1].Point:=-1;
  1412.           InclTab[2].Zone:=-2;
  1413.         END;
  1414.         DecodeAdr(ExclTab,NodeListSegRec.Exclude) ;
  1415.         FillChar(CurAdr, SizeOf(CurAdr), 0);
  1416.         CurAdr.Zone:=NodelistSegRec.DefaultZone;
  1417.         IF FirstRec And (Cfg.NodeListTyp=NewNodeListType) THEN ProcessNodeListLine('');
  1418.         IF Cfg.NodeListTyp IN [QBBSNodeListType,RANodeListType,SBBSNodeListType] THEN
  1419.           AddFileNum(JustFileName(oldnlname),FirstRec);
  1420.         HostPhone:='';
  1421.         CurNLPos:=0;
  1422.         WHILE NOT f.EoF DO
  1423.         BEGIN
  1424.           f.ReadLn(s);
  1425.           ProcessNodeListLine(s);
  1426.         END;
  1427.         f.Done;
  1428.         Temp^.wFastWrite(CharStr(' ',59),WhereY,1,Cfg.Color[2].TextColor);
  1429.       END;
  1430.       FirstRec:=False;
  1431.     END;
  1432.     WriteLn(#13#10,'Closing compiled nodelist...');
  1433.     if (Cfg.NodeListTyp=Version7) then   { Indsat BK '95 }
  1434.      begin
  1435.        f2.seek(512); { indsat BK'94 }
  1436.        for v7num := 1 to controlblock.ControlHiBlock do
  1437.         begin
  1438.           v7.reta(v7num,0,tempblock);
  1439.           f2.write(tempblock,controlblock.controlblocksize);
  1440.         end;
  1441.        v7.done;
  1442.        f2.seek(0); { indsat BK'94 }
  1443.        with controlblock do
  1444.          ControlParity := ControlBlockSize XOR ControlRoot
  1445.                           XOR ControlHiBlock XOR ControlLowLeaf
  1446.                           XOR ControlHighLeaf XOR ControlFree
  1447.                           XOR ControlLevels;
  1448.        f2.Write(controlblock,controlblock.controlblocksize); { indsat BK'94 }
  1449.      end;
  1450.     f2.Done;
  1451.     IF Not (Cfg.NodeListTyp IN [RANodeListType,SBBSNodelistType,QBBSNodeListType]) THEN f1.Done;
  1452.     OpenLockFile;
  1453.     REPEAT
  1454.       GiveUpTime;
  1455.     UNTIL NetGrabFile(NetNLFile);
  1456.     CASE Cfg.NodeListTyp OF
  1457.       NewNodeListType : BEGIN
  1458.                           DeleteFile(Cfg.NodeList+'NODELIST.IDX');
  1459.                           DeleteFile(Cfg.NodeList+'NODELIST.DAT');
  1460.                           RenameFile(MakeTaskFileName(Cfg.NodeList+'POP_NL.IDX'),
  1461.                                      Cfg.NodeList+'NODELIST.IDX');
  1462.                           RenameFile(MakeTaskFileName(Cfg.NodeList+'POP_NL.DAT'),
  1463.                                      Cfg.NodeList+'NODELIST.DAT');
  1464.                         END;
  1465.       SBBSNodeListType,
  1466.       QBBSNodeListType,
  1467.       RANodeListType :  BEGIN
  1468.                           DeleteFile(Cfg.NodeList+ListExtension('NODEIDX.'));
  1469.                           RenameFile(MakeTaskFileName(Cfg.NodeList+'POP_NL.IDX'),
  1470.                                      Cfg.NodeList+ListExtension('NODEIDX.'));
  1471.                         END;
  1472.       Version7       :  BEGIN
  1473.                           DeleteFile(Cfg.NodeList+'NODEX.NDX');
  1474.                           DeleteFile(Cfg.NodeList+'NODEX.DAT');
  1475.                           DeleteFile(Cfg.NodeList+'SYSOP.NDX');
  1476.                           RenameFile(MakeTaskFileName(Cfg.NodeList+'POP_NL.IDX'),
  1477.                                      Cfg.NodeList+'NODEX.NDX');
  1478.                           RenameFile(MakeTaskFileName(Cfg.NodeList+'POP_NL.DAT'),
  1479.                                      Cfg.NodeList+'NODEX.DAT');
  1480.                         END;
  1481.     END;
  1482.     NetReleaseFile(NetNLFile);
  1483.     CloseLockFile;
  1484.     SetToDoFlags(ICTDReReadNLIdx);
  1485.     IF Cfg.NLCompiler.UseFidoUserLst THEN
  1486.     BEGIN
  1487.       Write('Sorting FIDOUSER.LST ');
  1488.       IF SortFidoUser THEN
  1489.       BEGIN
  1490.         WriteLn(#13#10'Writing sorted FIDOUSER.LST');
  1491.         IF FidoUserLst.Init(Cfg.NodeList+'FIDOUSER.LST', SCreate, Max64k(MaxAvail-1024)) THEN
  1492.         BEGIN
  1493.           FOR i:=0 TO FidoUserNum DO
  1494.           BEGIN
  1495.             FidoUser.RetA(i,0,s);
  1496.             FidoUserLst.WriteLn(s);
  1497.           END;
  1498.           FidoUserLst.Done;
  1499.         END ELSE
  1500.           WriteLn('Error opening FIDOUSER.LST');
  1501.         WriteLn(#13#10'Done');
  1502.       END ELSE
  1503.         WriteLn(#13#10'Sorting of FIDOUSER.LST aborted!');
  1504.       FidoUser.Done;
  1505.     END;
  1506.     WaitForAction(10);
  1507.   END;
  1508.  
  1509. BEGIN
  1510. {$IFNDEF PoPLite}
  1511.   IF (Cfg.TaskType=2) AND (NOT Forced) THEN
  1512.   BEGIN
  1513.     RequestFunction(fsCompileNodelist);
  1514.     EXIT;
  1515.   END;
  1516.   FillChar(Call, SizeOf(Call), 0);
  1517.   IF Not SetInterCom(ICNLComp,Call,False) THEN Exit;
  1518.   IF NodeListSegFile.Open(StartPath+PoPNLSegmentFileName,SizeOf(TNodeListSeg),False) THEN
  1519.   BEGIN
  1520.     FreeUpMemory;
  1521.     MyWin(Temp,10,8,70,20,2,'NodeList Compiler',True);
  1522.     IF MaxAvail>65536 THEN
  1523.     BEGIN
  1524.       IF NOT Cfg.NLCompiler.UseFidoUserLst OR (DriveFree(Ord(Cfg.Nodelist[1])-64)>2048000) THEN
  1525.       BEGIN
  1526.         FoundOne:=Forced;
  1527.         WHILE Not NodeListSegFile.EoF DO
  1528.         BEGIN
  1529.           NodeListSegFile.Read(NodeListSegRec,NoKeep,Wait);
  1530.           IF FindOldNlName(OldNlName, Num) AND (NodeListSegRec.DiffFileName<>'') AND ProcessNodeDiff THEN FoundOne:=True;
  1531.         END;
  1532.         IF FoundOne THEN ProcessNodeList;
  1533.       END ELSE
  1534.         AddLog('!','Not enough free disk space on drive '+Copy(Cfg.NodeList,1,2)+' to compile nodelist');
  1535.     END ELSE
  1536.       AddLog('!','Not enough memory to compile nodelist');
  1537.     KillWindow(Temp);
  1538.     InitialiseNodeList(Cfg.NodeList,Cfg.NodeListTyp);
  1539.     NodeListSegFile.Close;
  1540.   END;
  1541. {$ENDIF}
  1542. END;
  1543.  
  1544. END.
  1545.